' //***************************************************************************
' // ***** Script Header *****
' //
' // Solution:  Solution Accelerator for Business Desktop Deployment
' // File:      WizUtility.vbs
' //
' // Purpose:   Common Utility functions used by UI Scripts
' //
' // Usage:     
' //        <script language="VBScript" src="ZTIUtility.vbs"/>
' //        <script language="VBScript" src="WizUtility.vbs"/>
' //
' // Microsoft Solution Version:  4.0.383
' // Microsoft Script Version:    4.0.383
' // Customer Build Version:      1.0.0
' // Customer Script Version:     1.0.0
' //
' // Microsoft History:
' // 2.6.0   KeithGa  03/01/2006   Created Program
' // 3.0.3   MTN      04/05/2006   Added DistributionSharePath, InstallPath
' // 3.0.103 MTN      11/06/2006   Fixed registry path
' // 3.0.110 MTN      11/14/2006   Trim spaces when checking for invalid file names
' // 3.0.134 MTN      01/02/2007   Added CheckCredentials functions
' // 3.0.138 MTN      01/10/2007   Fixed CheckCredentials to not generate error
' //                               when trying ADSI call in Windows PE.
' // 4.0.383 MTN      11/06/2007   Use parameters passed to CheckCredentials.
' //
' // Customer History:
' //
' // ***** End Header *****
' //***************************************************************************


Function BrowseForFolder(sDefaultValue)
	Dim iRetVal


	iRetVal = Success

	' Workaround for BrowseForFolder problem when called from an HTA:  sometimes it doesn't show up.

	oEnvironment.Item("DefaultFolderPath") = sDefaultValue
	iRetVal = oShell.Run("wscript.exe """ & oUtility.ScriptDir & "\LTIGetFolder.wsf""", 1, true)
	If iRetVal = 0 then
		BrowseForFolder = oEnvironment.Item("FolderPath")
	Else
		BrowseForFolder = sDefaultValue
	End if


End Function


'
' Creates a dialog box that enables the user to select a folder and then returns the selected folder's path.
'    See: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/shell/browseforfolder.asp
'
Function BrowseForSubfolder(sLocalRootDir, sDefaultValue)
	Dim oFolder
	
	Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Select Folder Containing Files", 0, sLocalRootDir)
	If not oFolder is nothing then
		If sLocalRootDir <> "" then
			BrowseForSubfolder = Mid(oFolder.self.Path, Len(sLocalRootDir)+2)  ' +1 to get the part after the prefix, +1 to skip the backslash
		Else
			BrowseForSubfolder = oFolder.self.Path
		End if
	Else
		BrowseForSubfolder = sDefaultValue
	End if
End Function


' 
' Parse the Command Line, used by mshta.exe which does not include Command Line Parsing functionality.
'   It will parse a single space delimited string into sub-strings. 
'   You may use quotes to include spaces within individual arguments.
'
' Returns a Regular Expression Matches Object.
'
' Uage Example:
'      for each item in ParseCommandLine("This"""" ""Is""e /define:""A TEst""")
'         Wscript.echo "   Argument: " & ITem
'      next
'
Function ParseCommandLine(CommandLine)

	Dim re

	Set re = new RegExp
	re.Pattern = "(""([^""]*)""|([^"" ]))+"
	re.Global = TRUE
   
	Set ParseCommandLine = re.execute(CommandLine)

End function 

 
Function GetNamedParameter(oArguments, sParameter)

	Dim i

	For i = 1 to oArguments.count - 1
		If Instr(1,oArguments.Item(i),sParameter & ":",vbTExtCompare) <> 0 then
			GetNamedParameter = mid(oArguments.Item(i),instr(1,oArguments.Item(i),sParameter & ":",vbTExtCompare) + len(sParameter & ":"))
			if right(GetNamedParameter,1) = """" and left(GetNamedParameter,1) = """" then
				GetNamedParameter = mid(GetNamedParameter,2,len(GetNamedParameter)-2)
			end if
		ElseIf instr(1,oArguments.Item(i),sParameter ,vbTExtCompare) <> 0 then
			GetNamedParameter = ""
		End if
	Next
    
End function 


'
' Call a VBScript and handle the errors
'

Function DisplayErrorIfAny ( sStatement ) 
	Dim sError

	If Err.Number = 0 then 
		Exit function 
	End if 
   
	'sError = sError & "Use Ctrl-C to copy the text of this message to the clipboard!" &  vbNewLine
	sError = sError & "A VBScript Runtime Error has occurred: " & vbNewLine & vbNewLine
	sError = sError & "Error: " & Err.Number & " = " & Err.Description & vbNewLine & vbNewLine
	sError = sError & "VBScript Code:" & vbNewLine & "-------------------" &  vbNewLine
	sError = sError & left(sStatement,800)
   
	oLogging.CreateEntry  sError ,LogTypeError
   
	If oLogging.Debug then
		sError = sError & vbNewLine & "-------------------" &  vbNewLine 
		sError = sError & "Do you wish to attempt debugging on this script?"
		DisplayErrorIfAny = MsgBox ( sError, vbYesNo , "VBScript Runtime Error" ) = vbYes
	Else
		Alert sError
		DisplayErrorIfAny = FALSE
	End if 
      
End function 


Function ExecuteWithErrorHandling ( statements ) 
	Dim RunAgain
   
	RunAgain = FALSE

	On error resume Next
	Err.Clear
	ExecuteGlobal statements      
	ExecuteWithErrorHandling = err.number = 0    
      
	RunAgain = DisplayErrorIfAny (statements)
	On error goto 0
   
	If RunAgain then
		ExecuteGlobal statements
	End if 

End function


Function EvalWithErrorHandling ( fn )
        oLogging.CreateEntry  "Entered Function EvalWithErrorHandling With fn value of = " & fn , LogTypeInfo
	RunAgain = FALSE
   
	On error resume Next
	Err.Clear
        oLogging.CreateEntry  "Error Handling Off, Calling Eval with a value of = " & fn , LogTypeInfo
	EvalWithErrorHandling = eval(fn)
        oLogging.CreateEntry  "Back in Function EvalWithErrorHandling" , LogTypeInfo
	EvalWIthErrorHandling = EvalWIthErrorHandling and (err.number = 0)

	RunAgain = DisplayErrorIfAny (fn)
	On error goto 0
   
	If RunAgain then
		EvalWithErrorHandling = eval(fn)
	End if 

End function 


'
' Create an XML Document Node with assoticated Elements and Attributes
'
'  Parameters:
'      oXMLDoc - XML DOM object ( Created from MSXML2.DOMDocument ) 
'  oTargetNode - XML Document Element where the element is created
'    sNodeName - Name of the Element Created
'  oAttributes - VBScript Dictionary object containing a list of XML Attributes to add
'    oElements - VBScript Dictionary object containing a list of XML Elements to add
'
'  Example Usage: 
'   dim     xmlDoc, oAttributes, oElements
'   set  oAttributes = CreateObject("Scripting.Dictionary")
'   set    oElements = CreateObject("Scripting.Dictionary")
'   Set       xmlDoc = CreateXMLDOMObject 
'   
'   xmlDoc.Load "c:\SomeFile.xml"     or   xmlDoc.appendChild xmlDoc.createElement("MyRootElement")
'   
'   oAttributes.Add "guid", left( CreateObject("Scriptlet.TypeLib").GUID, 38 ) ' Strip trailing NULL's
'     oElements.Add "Name","BuildName.value"
'     oElements.Add "Version","1.0"
'     
'   CreateXMLNode xmlDoc, xmlDoc.documentElement, "MyElement", oAttributes, oElements
' 
'   xmlDoc.Save "c:\SomeFile.xml" 
'   

Function CreateXMLNode ( xmlDoc, oTargetNode, sNodeName, oAttributes , oElements)

	Dim Key, oElement, oNodeRoot
   
	Set oNodeRoot = xmlDoc.createElement(sNodeName)
   
	For each key in oAttributes
		If IsEmpty(key) then
			Exit For
		End if
		oNodeRoot.setAttribute key, oAttributes.Item(key)
	Next
   
	For each key in oElements.Keys
		If isempty(key) then exit for
		Set oElement = xmlDoc.createElement(key)
		oElement.text = oElements.Item(key)
		oNodeRoot.appendChild oElement      
	Next
   
	oTargetNode.appendChild oNodeRoot

End function 


'
' Returns a string containing the local distribution folder (not for deployments)
'
Function DistributionSharePath

	DistributionSharePath = oShell.RegRead("HKLM\Software\Microsoft\Deployment 4\Distribution_Dir")
	If not oFso.FolderExists(DistributionSharePath) then
		Err.Raise 507, "Local BDD Distribution folder was not found!"
	End if
	While right(DistributionSharePath, 1) = "\"    ' remove any trailing 
		DistributionSharePath = mid(DistributionSharePath,1,len(DistributionSharePath)-1)    
	Wend 

End function 


'
' Returns a string containing the local installation folder
'
Function InstallPath

	InstallPath = oShell.RegRead("HKLM\Software\Microsoft\Deployment 4\Install_Dir")
	If not oFso.FolderExists(InstallPath) then
		Err.Raise 507, "Local BDD installation folder was not found!"
	End if
	While right(InstallPath,1) = "\"    ' remove any trailing 
		InstallPath = mid(InstallPath,1,len(InstallPath)-1)
	Wend 

End Function


'
' hide/unhide an DHTML element
'
Sub HideUnhide ( oHTMLElement, isVisible ) 

	If isVisible then
		oHTMLElement.style.display = "inline"
	Else
		oHTMLElement.style.display = "none"
	End if

End sub 


'
' Copy Files to a folder
'
'  More information: 
'      http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/folder/copyhere.asp
' 
' WARNING: There is no way to tell if the user hits the Cancel Button during copy.
'
' Parameters:
'       Source - Item or items to copy. Can be a file name string, a FolderItem object, or a FolderItems object.
'     sDestDir - Target Destination Directory. If missing then this procedure will create the directory.
'        Flags - Copy Flags for CopyHere (Typical settings: 2048 or 16 ===> 2064 ):
'   CleanFirst - Clean the directory first.
'  
Sub CopyFileWithProgressEx ( Source , sDestDir, Flags, CleanFirst )

	Dim objFolder, hr
   
	If CleanFirst and oFso.FolderExists( sDestDir ) then
		oFSO.DeleteFolder sDestDir
	End if

	' Open the Destination Directory (Create if missing)
	oUtility.VerifyPathExists sDestDir
	Set objFolder = CreateObject("Shell.Application").NameSpace(sDestDir)
   
	If objFolder is nothing then   
		Err.Raise 507,,"Destination Folder not set: " & sDestDir
		Exit sub    
	End if  
   
	objFolder.CopyHere Source, Flags
	Set objFolder = nothing
   
End sub


Sub CopyFileWithProgress ( Source , sDestDir )
	' Common Settings
	'    16 Respond with "Yes to All" for any dialog box that is displayed.  
	'  2048 Version 4.71. Do not copy the security attributes of the file. 
	CopyFileWithProgressEx Source , sDestDir, 2064, TRUE
End sub



'
' Tests a filename for invalid characters.
'
Function IsValidFileName (FileName)

	Dim regEx

	Set regEx = New RegExp 
	regEx.Pattern = "[\x00-\x1F\<\>\:\""\/\\\|\%\*\?\']"   'Strict Subset
	IsValidFileName = (not regEx.Test ( FileName )) and (trim(FileName) <> "") and len(trim(FileName)) <= 253
   
	Select Case UCase(Trim(FileName))
	Case "CON", "AUX", "COM1", "COM2", "COM3", "COM4", "LPT1", "LPT2", "LPT3", "PRN", "NUL" 
		IsValidFileName = FALSE
	End select
   
End function 


Function IsValidPath (FilePath)

	Dim regEx

	Set regEx = New RegExp 
	regEx.Pattern = "[\x00-\x1F\<\>\""\%\*\?\']"   'Strict Subset
	IsValidPath = (not regEx.Test ( FilePath )) and (trim(FilePath) <> "") and len(trim(FilePath)) <= 253
   
End function 


Function IsValidComputerName ( ComputerName )

	Dim regEx
	Set regEx = New RegExp 
	regEx.Pattern = "[^a-zA-Z0-9\-\_]"   'Strict Subset
	' regEx.Pattern = "[^a-zA-Z0-9\!\@\#\$\%\^\&\'\)\(\.\-\_\{\}\~ ]" ' SetComputerName compliant
	IsValidComputerName 	= not regEx.Test ( ComputerName ) and len(ComputerName) <= 15

End function


'
' Create a delimited list of items, one at a time.
'   List must be empty before calling for the first time.
'   Empty is the default state for all uninitialized variables.
'
Sub AddToList(byref List, Item, Delimiter)  
	If isempty(list) then 
		List = cstr(item)
	Else 
		list = list & delimiter & cstr(Item)
	End if 
End sub 


'
' Force a value to a string format.
'   Non-printable types will return empty.
'
Function ForceAsString ( InputVar )
	Dim InputType, Item
    
	InputType = VarType(InputVar)

	If isObject(InputVar) or isNull(InputVar) or isEmpty(InputVar) then
		' Do nothing, return empty    
    
	ElseIf InputType = vbError or InputType = vbVariant or InputType = vbDataObject then
		' Do Nothing, return empty
        
	ElseIf InputType = ( vbArray or vbByte ) then
    
		For item = 1 to LenB( InputVar )
			AddToList ForceAsString, ForceAsString( hexWidth(midb(InputVar,Item,1),2) ), ""
		Next 

	ElseIf IsArray(InputVar) then
		For each item in InputVar        
			' Recurse into ForceAsString to parse each item in the array
			AddToList ForceAsString, ForceAsString(Item), " "
		Next    
        
	ElseIf InputType = vbByte then
		ForceAsString =  hex( ascb( value ) )
        
	Else
		ForceAsString = cstr(InputVar)
       
	End if

End function 


Function IsWhiteSpace (MyChar)
	' Chr(9) = vtTab, Chr(10) = vbLF, Chr(11) = vbVerticalTab, Chr(12) = vbFormFeed, chr(13) = vbCr
	IsWhiteSpace = MyChar = " " or ( MyChar >= chr(9) and MyChar <= chr(13) ) 
End function 


Function TrimAllWS( MyString )

	While len(MyString) > 0 and IsWhiteSpace(left(MyString,1))
		MyString = Mid(MyString,2)
	Wend
   
	While len(MyString) > 0 and IsWhiteSpace(right(MyString,1)) 
		MyString = Mid(MyString,1,len(MyString)-1)
	Wend   
   
	TrimAllWS = MyString
End function


'
' Validate Credentials against either a Domain or a UNC Disk Resource
'   Function will return TRUE if successfull, otherwise it will return an ERROR string!
'
Function CheckCredentials(sValidateUNC, sUserName, sDomain, sPassword)

	Dim sFullUserName
	Dim sJustUserName
	Dim sUserObjectPath
	Dim oWinNT
	Dim oDomain ' As IADsDomain 
	Dim sDriveLetter


	sFullUserName = sUserName
	If sDomain <> "" then
		sFullUserName = sDomain & "\" & sFullUserName
	End if
    

	If sValidateUNC <> "" then
    
		'
		' Validate the credentials against an actual UNC disk resource
		'
    
		sDriveLetter = oUtility.MapNetworkDriveEx (sValidateUNC, sFullUserName, sPassword )
        
		If len(sDriveLetter) = 2 then
			If bLeaveShareOpen <> TRUE then
				oNetwork.RemoveNetworkDrive sDriveLetter
			End if
			CheckCredentials = TRUE
		Else
			CheckCredentials = sDriveLetter ' If not a drive letter, then this is an error string
		End if

	Else

		'
		' Validate the credentials against a domain or computer server using Active Directory authentication.
		'
        
		' The credentials can be in the form "BillG", "redmond\BillG", or "BillG@Microsoft.Com". Cleanup for use.
    
		sJustUserName = sUserName
		If Instr(1,sJustUserName,"@") <> 0 then
			' Username is in form: BillG@redmond.corp.Microsoft.com, remove domain.
			sJustUserName = left(sJustUserName, instr(1,sJustUserName,"@") - 1)
		ElseIf instr(1,sJustUserName,"\") <> 0 then
			' Username is in form: redmond\BillG, remove domain.
			sJustUserName = mid(sJustUserName, instr(1,sJustUserName,"\") + 1 )    
		End if
       
		If sDomain <> "" then
			sUserObjectPath = sDomain
		ElseIf Instr(1, sUserName, "\") <> 0 then
			sUserObjectPath = left(sUserName, instr(1, sUserName, "\") - 1)          
		ElseIf Instr(1, sUserName, "@") <> 0 then
			sUserObjectPath = mid(sJustUserName, instr(1,sJustUserName,"@") + 1 ) 
		Else
			CheckCredentials = "Could not detemine the domain."
			Exit function
		End if 
    
		On Error Resume Next
		Set oWinNT = GetObject("WinNT:")
		If Err then
			If oEnvironment.Item("OSVersion") = "WinPE" then
				oLogging.CreateEntry "Unable to verify domain credentials in Windows PE since ADSI is not available", LogTypeInfo
				CheckCredentials = TRUE
				Err.Clear
				Exit Function
			Else
				CheckCredentials = Err.Description & " (" & Hex(Err.Number) & ")"
				Exit Function
			End if
		End if


		' 1 = ADS_SECURE_AUTHENTICATION
		Set oDomain = oWinNT.OpenDSObject("WinNT://" & sUserObjectPath & "/" & sJustUserName &  ",user" ,  sFullUserName, sPassword, 1 )

		If Err.Number = &h80070035 then
			CheckCredentials = "Network path not found (80070035)"
		ElseIf Err.Number = &H8007054B then
			CheckCredentials = "Domain could not be contacted (8007054B)"
		ElseIf Err.Number = &h8007052E then
			CheckCredentials = "User ID or password is invalid (8007052E)"
		ElseIf Err.Number = &h800708AD then
			CheckCredentials = "User ID is not valid (800708AD)"
		ElseIf Err then
			CheckCredentials = Err.Description & " (" & Hex(Err.Number) & ")"
		ElseIf oDomain is nothing then
			CheckCredentials = "Domain validation failed - " & Err.Description & " (" & Err.Number & ")"
		Else
			Err.Clear
			CheckCredentials = TRUE
		End if 
		On error goto 0
    
	End if

	If CheckCredentials <> TRUE then
		oLogging.CreateEntry "Credentials Script: " & CheckCredentials, LogTypeWarning
		Exit function
	End if 
    
	oEnvironment.Item("UserCredentials") = Cstr(TRUE)
    
	If bDoNotSaveParameters = TRUE then
		window.close
		CheckCredentials = FALSE  
	End if

End Function 


Function GetDomainDefault
	Dim oComputer


	' Get Local Domain

	GetDomainDefault = ""
	if oEnvironment.Item("UserDomain") <> "" then
		GetDomainDefault = oEnvironment.Item("USERDOMAIN")
	else
		On Error Resume Next
		For each oComputer in objWMI.InstancesOf("Win32_ComputerSystem")
			If oComputer.DomainRole <> 0 then
				GetDomainDefault = oComputer.Domain
			End if
		Next 
		On Error Goto 0
	end if

End Function
